Adam Richardson's Site

cl-sdl2 Notes

Table of Contents

<2022-05-01 Sun>

Setup

  • Github: cl-sdl2
    • I was unable to get defpackage-plus to work in clisp, it does work with sbcl
  • Go into ~/quicklisp/local-projects folder
    • Clone git clone https://github.com/rpav/cl-autowrap.git
    • Clone git clone https://github.com/lispgames/cl-sdl2.git
  • Inside the lisp repl install quick load sdl2, (ql:quickload "sdl2")
  • Try one of the example
(ql:quickload :sdl2/examples)
(sdl2-examples:basic-test)

Reading the Examples

  • If the above instructions are followed then the examples can be found in ~/quicklisp/local-projects/cl-sdl2/examples

Loading cl-sdl2 library

  • In the REPL run (ql:quickload :sdl2) to load the cl-sdl2 library

Requiring SDL2

(require :sdl2)

Initializing SDL2

(sdl2:with-init (:everything)
  ...)

Creating a Window

(sdl2:with-window (win :title "TITLE" :flags '(:shown))
  ...)

Render

Creating a Renderer

(sdl2:with-renderer (renderer win :flags '(:accelerated))
  ...)

Setting Draw Color

  • Each color value is a number between 0-255
(sdl2:set-render-draw-color
 renderer
 000 # Red
 000 # Green
 000 # Blue
 255 # Opacity
 )

Clearing the Renderer

  • Clears the screen with the current draw color
(sdl2:render-clear renderer)

Presenting the Renderer

  • Presenting the renderer flips the back buffer so the window displays the contents
(sdl2:render-present renderer)

Drawing a Rectangle

(sdl2:render-fill-rect renderer
                       (sdl2:make-rect x y w h))

Events

Creating an Event Loop

  • Various event types can be found in *event-type-to-accessor* in events.lisp
(sdl2:with-event-loop (:method :poll)
  (:keyup
   ...)
  (:idle
   ...)
  (:quit () t))

Listening for a particular key up event

(:keyup
 (:keysym keysym)
 (when (sdl2:scancode= (sdl2:scancode-value keysym) :scancode-escape)
   ...))

Pushing a Quit Event

(sdl2:push-event :quit)

Timing

Delay

  • It is a good idea to add a delay to your event loop if you are not running in VSYNC mode
  • If you do not it will max out a CPU core
  • The delay function accepts a millisecond amount to sleep the thread
(sdl2:delay delay-ms)

DVD Logo Example

  • This example displays a bouncing rectangle
  • It's aim is to be similar to this screen saver seen here in The Office

DVD Logo Demonstration Video

Structures

Point

(defstruct point
  (x 0)
  (y 0))

Color

(defstruct color
  (r 0)
  (g 0)
  (b 0)
  (opacity 255))

Drawable

(defstruct (drawable (:include point))
  (color (make-color))
  (opacity 255))

Rectangle

(defstruct (rectangle (:include drawable))
  (w 0)
  (h 0))

Pattern

(defstruct pattern
  "A `pattern' is a string with two characters repeating. One
character represents an active pixel the other character represents a
blank pixel. This can be used to define monochrome sprites, such as
bitmap fonts. The string represents a linearized 2D array. In order to
size the rectangle a `row-stride' is needed. The `row-stride'
indicates how wide each row is in the pattern. The `scale' indicates
how large in pixels each square pixel of the pattern is. The
`active-color' is an instance of the `color' struct and defaults to
black. The `inactive-color' is also an instance of `color' and
defaults to white. The `active-char' is the character in the pattern
string that indicates the pixel should be active or on. By default the
`active-char' is '#'. Similarly the `inactive-char' is the character
that indicates a pixel is off and defaults to '.'.

Example:

'..#.....#..#..#...#..##.#######.####.###.##############.#########...#.....#...#.......#'

The above pattern is on of the aliens from the game space
invaders. The row stride is 11 which should have an 11x8 sized sprite."
  (pattern "#..#.##.#..#")
  (row-stride 4)
  (scale 1)
  (offset (make-point))
  (active-color (make-color :r #xFF :g #xFF :b #xFF))
  (inactive-color (make-color :r #x00 :g #x00 :b #x00))
  (active-char #\#)
  (inactive-char #\.))

Globals

(defparameter *world-width* 800)
(defparameter *world-height* 600)

(defparameter *dvd-rect* (make-rectangle
                          :x (random (- *world-width* 150))
                          :y (random (- *world-height* 100))
                          :w 150
                          :h 100
                          :color (make-color
                                  :r #xFF
                                  :g #x00
                                  :b #x00)))

(defparameter *dvd-dir* (make-point :x 3 :y 3))

(defparameter *last-update* 0)
(defparameter *update-per-sec* (/ 1.0 60))

Utility Functions

Apply Direction

(defun apply-dir (point dir)
  "Applies the direction vector `dir' to the `point'.
Both `dir' and `point' are point structures."
  (setf (point-x point) (+ (point-x point)
                           (point-x dir)))
  (setf (point-y point) (+ (point-y point)
                           (point-y dir))))

Invert Point

(defun invert-point (point invert-x invert-y)
  "Multiplies the x value by -1 if `invert-x' is not nil.
Multiplies the y value by -1 if the `invert-y' is not nil."
  (when invert-x
    (setf (point-x point)
          (* (point-x point) -1)))
  (when invert-y
    (setf (point-y point)
          (* (point-y point) -1))))

Out of Bounds Predicate

(defun out-of-bounds-p (rectangle)
  "Checks to see if the rectangle is within the bounds of `*world-width*'
and `*world-height'. If not it returns a cons pair of two numbers. The car
will be 1 when the rectangle is out of bounds in the x direction, otherwise
nil. The other digit in the pair is the same but for y axis."
  (let ((x-out-of-bounds
          (or (> 0 (rectangle-x rectangle))
              (< *world-width*
               (+ (rectangle-w rectangle)
                    (rectangle-x rectangle)))))
        (y-out-of-bounds
          (or (> 0 (rectangle-y rectangle))
              (< *world-height*
                 (+ (rectangle-h rectangle)
                    (rectangle-y rectangle))))))
    (if (or x-out-of-bounds
            y-out-of-bounds)
        (cons (if x-out-of-bounds 1 nil)
              (if y-out-of-bounds 1 nil))
        nil)))

Randomize Drawable Color

(defun randomize-drawable-color (drawable)
  "Changes the color on the drawable to a random color"
  (setf (drawable-color drawable)
        (make-color
         :r (random #xFF)
         :g (random #xFF)
         :b (random #xFF))))

Invert Color

  • This function creates a new color that is the opposite of the argument color
(defun invert-color (color)
  "Returns the complement color by subtracting 255 from each RGB
value."
  (make-color
   :r (- #xFF (color-r color))
   :g (- #xFF (color-g color))
   :b (- #xFF (color-b color))))

Pattern To Rects

(defun pattern->rects (pattern)
  "Returns a list of rects for the pattern"
  (flet ((is-active-p (c)
           (equal c (pattern-active-char pattern))))
    (let ((pattern-list (coerce (pattern-pattern pattern) 'list))
          (rects nil))
      (loop for i below (length pattern-list)
            do (let* ((char (nth i pattern-list))
                      (x (+ (point-x (pattern-offset pattern))
                            (* (mod i (pattern-row-stride pattern))
                               (pattern-scale pattern))))
                      (y (+ (point-y (pattern-offset pattern))
                            (* (floor i (pattern-row-stride pattern))
                               (pattern-scale pattern))))
                      (rect (make-rectangle
                             :x x
                             :y y
                             :w (pattern-scale pattern)
                             :h (pattern-scale pattern)
                             :color (if (is-active-p char)
                                        (pattern-active-color pattern)
                                        (pattern-inactive-color pattern)))))
                 (if rects
                     (push rect (cdr rects))
                     (setf rects (list rect)))))
      rects)))

String To Rects

(defun string->rects (string &optional
                               (offset (make-point))
                               (scale 1)
                               (active-color (make-color))
                               (inactive-color (make-color)))
  "Returns a list of rects that make up the `string'. The `offset' is
the top left corner of the first character. The `scale' represents the
height of each character in the string. The `active-color' is the
foreground color of the character. The `inactive-color' is the
background color of the string."
  (let ((char-pattern-table (make-hash-table))
        (string-list (coerce string 'list)))
    ;; Populate the hash table
    (progn
      (setf (gethash #\! char-pattern-table)
            "...##.....####....####.....##......##..............##...........")
      (setf (gethash #\" char-pattern-table)
            ".##.##...##.##..................................................")
      (setf (gethash #\# char-pattern-table)
            ".##.##...##.##..#######..##.##..#######..##.##...##.##..........")
      (setf (gethash #\$ char-pattern-table)
            "..##.....#####..##.......####.......##..#####.....##............")
      (setf (gethash #\% char-pattern-table)
            "........##...##.##..##.....##.....##.....##..##.##...##.........")
      (setf (gethash #\& char-pattern-table)
            "..###....##.##....###....###.##.##.###..##..##...###.##.........")
      (setf (gethash #\' char-pattern-table)
            ".##......##.....##..............................................")
      (setf (gethash #\( char-pattern-table)
            "...##.....##.....##......##......##.......##.......##...........")
      (setf (gethash #\) char-pattern-table)
            ".##.......##.......##......##......##.....##.....##.............")
      (setf (gethash #\* char-pattern-table)
            ".........##..##...####..########..####...##..##.................")
      (setf (gethash #\+ char-pattern-table)
            "..........##......##....######....##......##....................")
      ;;                                ;
      ;; "..........................................##......##.....##.....")
      (setf (gethash #\- char-pattern-table)
            "........................######..................................")
      (setf (gethash #\. char-pattern-table)
            "..........................................##......##............")
      (setf (gethash #\/ char-pattern-table)
            ".....##.....##.....##.....##.....##.....##......#...............")
      (setf (gethash #\0 char-pattern-table)
            ".#####..##...##.##..###.##.####.####.##.###..##..#####..........")
      (setf (gethash #\1 char-pattern-table)
            "..##.....###......##......##......##......##....######..........")
      (setf (gethash #\2 char-pattern-table)
            ".####...##..##......##....###....##.....##..##..######..........")
      (setf (gethash #\3 char-pattern-table)
            ".####...##..##......##....###.......##..##..##...####...........")
      (setf (gethash #\4 char-pattern-table)
            "...###....####...##.##..##..##..#######.....##.....####.........")
      (setf (gethash #\5 char-pattern-table)
            "######..##......#####.......##......##..##..##...####...........")
      (setf (gethash #\6 char-pattern-table)
            "..###....##.....##......#####...##..##..##..##...####...........")
      (setf (gethash #\7 char-pattern-table)
            "######..##..##......##.....##.....##......##......##............")
      (setf (gethash #\8 char-pattern-table)
            ".####...##..##..##..##...####...##..##..##..##...####...........")
      (setf (gethash #\9 char-pattern-table)
            ".####...##..##..##..##...#####......##.....##....###............")
      (setf (gethash #\: char-pattern-table)
            "..........##......##......................##......##............")
      (setf (gethash #\; char-pattern-table)
            "..........##......##......................##......##.....##.....")
      (setf (gethash #\< char-pattern-table)
            "...##.....##.....##.....##.......##.......##.......##...........")
      (setf (gethash #\= char-pattern-table)
            "................######..................######..................")
      (setf (gethash #\> char-pattern-table)
            ".##.......##.......##.......##.....##.....##.....##.............")
      (setf (gethash #\? char-pattern-table)
            ".####...##..##......##.....##.....##..............##............")
      (setf (gethash #\@ char-pattern-table)
            ".#####..##...##.##.####.##.####.##.####.##.......####...........")
      (setf (gethash #\A char-pattern-table)
            "..##.....####...##..##..##..##..######..##..##..##..##..........")
      (setf (gethash #\B char-pattern-table)
            "######...##..##..##..##..#####...##..##..##..##.######..........")
      (setf (gethash #\C char-pattern-table)
            "..####...##..##.##......##......##.......##..##...####..........")
      (setf (gethash #\D char-pattern-table)
            "#####....##.##...##..##..##..##..##..##..##.##..#####...........")
      (setf (gethash #\E char-pattern-table)
            "#######..##...#..##.#....####....##.#....##...#.#######.........")
      (setf (gethash #\F char-pattern-table)
            "#######..##...#..##.#....####....##.#....##.....####............")
      (setf (gethash #\G char-pattern-table)
            "..####...##..##.##......##......##..###..##..##...#####.........")
      (setf (gethash #\H char-pattern-table)
            "##..##..##..##..##..##..######..##..##..##..##..##..##..........")
      (setf (gethash #\I char-pattern-table)
            ".####.....##......##......##......##......##.....####...........")
      (setf (gethash #\J char-pattern-table)
            "...####.....##......##......##..##..##..##..##...####...........")
      (setf (gethash #\K char-pattern-table)
            "###..##..##..##..##.##...####....##.##...##..##.###..##.........")
      (setf (gethash #\L char-pattern-table)
            "####.....##......##......##......##...#..##..##.#######.........")
      (setf (gethash #\M char-pattern-table)
            "##...##.###.###.#######.#######.##.#.##.##...##.##...##.........")
      (setf (gethash #\N char-pattern-table)
            "##...##.###..##.####.##.##.####.##..###.##...##.##...##.........")
      (setf (gethash #\O char-pattern-table)
            "..###....##.##..##...##.##...##.##...##..##.##....###...........")
      (setf (gethash #\P char-pattern-table)
            "######...##..##..##..##..#####...##......##.....####............")
      (setf (gethash #\Q char-pattern-table)
            ".####...##..##..##..##..##..##..##.###...####......###..........")
      (setf (gethash #\R char-pattern-table)
            "######...##..##..##..##..#####...##.##...##..##.###..##.........")
      (setf (gethash #\S char-pattern-table)
            ".####...##..##..###......###.......###..##..##...####...........")
      (setf (gethash #\T char-pattern-table)
            "######..#.##.#....##......##......##......##.....####...........")
      (setf (gethash #\U char-pattern-table)
            "##..##..##..##..##..##..##..##..##..##..##..##..######..........")
      (setf (gethash #\V char-pattern-table)
            "##..##..##..##..##..##..##..##..##..##...####.....##............")
      (setf (gethash #\W char-pattern-table)
            "##...##.##...##.##...##.##.#.##.#######.###.###.##...##.........")
      (setf (gethash #\X char-pattern-table)
            "##...##.##...##..##.##....###.....###....##.##..##...##.........")
      (setf (gethash #\Y char-pattern-table)
            "##..##..##..##..##..##...####.....##......##.....####...........")
      (setf (gethash #\Z char-pattern-table)
            "#######.##...##.#...##.....##.....##..#..##..##.#######.........")
      (setf (gethash #\[ char-pattern-table)
            ".####....##......##......##......##......##......####...........")
      (setf (gethash #\" char-pattern-table)
            "##.......##.......##.......##.......##.......##.......#.........")
      (setf (gethash #\] char-pattern-table)
            ".####......##......##......##......##......##....####...........")
      (setf (gethash #\^ char-pattern-table)
            "...#......###....##.##..##...##.................................")
      (setf (gethash #\_ char-pattern-table)
            "........................................................########")
      (setf (gethash #\` char-pattern-table)
            "..##......##.......##...........................................")
      (setf (gethash #\a char-pattern-table)
            ".................####.......##...#####..##..##...###.##.........")
      (setf (gethash #\b char-pattern-table)
            "###......##......##......#####...##..##..##..##.##.###..........")
      (setf (gethash #\c char-pattern-table)
            ".................####...##..##..##......##..##...####...........")
      (setf (gethash #\d char-pattern-table)
            "...###......##......##...#####..##..##..##..##...###.##.........")
      (setf (gethash #\e char-pattern-table)
            ".................####...##..##..######..##.......####...........")
      (setf (gethash #\f char-pattern-table)
            "..###....##.##...##.....####.....##......##.....####............")
      (setf (gethash #\g char-pattern-table)
            ".................###.##.##..##..##..##...#####......##..#####...")
      (setf (gethash #\h char-pattern-table)
            "###......##......##.##...###.##..##..##..##..##.###..##.........")
      (setf (gethash #\i char-pattern-table)
            "..##.............###......##......##......##.....####...........")
      (setf (gethash #\j char-pattern-table)
            "....##..............##......##......##..##..##..##..##...####...")
      (setf (gethash #\k char-pattern-table)
            "###......##......##..##..##.##...####....##.##..###..##.........")
      (setf (gethash #\l char-pattern-table)
            ".###......##......##......##......##......##.....####...........")
      (setf (gethash #\m char-pattern-table)
            "................##..##..#######.#######.##.#.##.##...##.........")
      (setf (gethash #\n char-pattern-table)
            "................#####...##..##..##..##..##..##..##..##..........")
      (setf (gethash #\o char-pattern-table)
            ".................####...##..##..##..##..##..##...####...........")
      (setf (gethash #\p char-pattern-table)
            "................##.###...##..##..##..##..#####...##.....####....")
      (setf (gethash #\q char-pattern-table)
            ".................###.##.##..##..##..##...#####......##.....####.")
      (setf (gethash #\r char-pattern-table)
            "................##.###...###.##..##..##..##.....####............")
      (setf (gethash #\s char-pattern-table)
            ".................#####..##.......####.......##..#####...........")
      (setf (gethash #\t char-pattern-table)
            "...#......##.....#####....##......##......##.#.....##...........")
      (setf (gethash #\u char-pattern-table)
            "................##..##..##..##..##..##..##..##...###.##.........")
      (setf (gethash #\v char-pattern-table)
            "................##..##..##..##..##..##...####.....##............")
      (setf (gethash #\w char-pattern-table)
            "................##...##.##.#.##.#######.#######..##.##..........")
      (setf (gethash #\x char-pattern-table)
            "................##...##..##.##....###....##.##..##...##.........")
      (setf (gethash #\y char-pattern-table)
            "................##..##..##..##..##..##...#####......##..#####...")
      (setf (gethash #\z char-pattern-table)
            "................######..#..##.....##.....##..#..######..........")
      (setf (gethash #\{ char-pattern-table)
            "...###....##......##....###.......##......##.......###..........")
      (setf (gethash #\| char-pattern-table)
            "...##......##......##..............##......##......##...........")
      (setf (gethash #\} char-pattern-table)
            "###.......##......##.......###....##......##....###.............")
      (setf (gethash #\~ char-pattern-table)
            ".###.##.##.###.................................................."))
    (let ((rects nil))
      (loop for i below (length string-list)
            do (let ((pattern (make-pattern
                               :pattern (gethash (nth i string-list)
                                                 char-pattern-table)
                               :row-stride 8
                               :offset (make-point
                                        :x (+ (* (* i 8) scale) (point-x offset))
                                        :y (point-y offset))
                               :scale scale
                               :active-color active-color
                               :inactive-color inactive-color)))
                 (setf rects (append (pattern->rects pattern) rects))))
      rects)))

SDL Utility Functions

Render Rectangle

(defun rectangle->sdl-render (rectangle renderer)
  (sdl2:set-render-draw-color
   renderer
   (color-r (rectangle-color rectangle))
   (color-g (rectangle-color rectangle))
   (color-b (rectangle-color rectangle))
   (rectangle-opacity rectangle))

  (sdl2:render-fill-rect renderer
                         (sdl2:make-rect
                          (rectangle-x rectangle)
                          (rectangle-y rectangle)
                          (rectangle-w rectangle)
                          (rectangle-h rectangle))))

Render Pattern

(defun render-rectangles (rects renderer)
  (mapc (lambda (rect)
          (rectangle->sdl-render rect renderer))
        rects))

DVD Logo Life Cycle Functions

Update

(defun update ()
  (apply-dir *dvd-rect* *dvd-dir*)
  (let ((out-of-bounds (out-of-bounds-p *dvd-rect*)))
    (when out-of-bounds
      (randomize-drawable-color *dvd-rect*)
      (invert-point *dvd-dir*
                    (car out-of-bounds)
                    (cdr out-of-bounds)))))

Draw

(defun draw (renderer)
  (sdl2:set-render-draw-color renderer 0 0 0 255)
  (sdl2:render-clear renderer)
  (rectangle->sdl-render *dvd-rect* renderer)
  (let* ((scale 4)
         (msg "DVD")
         (rects (string->rects
                 msg
                 (make-point
                  :x (+ (point-x *dvd-rect*)
                        (floor (- (rectangle-w *dvd-rect*)
                                  (* 8 scale (length msg)))
                               2))
                  :y (+ (point-y *dvd-rect*)
                        (floor (- (rectangle-h *dvd-rect*)
                                  (* 8 scale))
                               2)))
                 scale
                 (invert-color (rectangle-color *dvd-rect*))
                 (rectangle-color *dvd-rect*))))
    (render-rectangles rects renderer))
  (sdl2:render-present renderer))

Main Loop

(defun dvd-logo ()
  "Bouncing DVD logo"
  (sdl2:with-init (:everything)
    (sdl2:with-window (win :title "DVD Logo"
                           :flags '(:shown)
                           :w *world-width*
                           :h *world-height*)
      (sdl2:with-renderer (renderer win :flags '(:accelerated))
        (sdl2:with-event-loop (:method :poll)
          (:keyup
           (:keysym keysym) ;; TODO is this special in the macro?
           (when (sdl2:scancode= (sdl2:scancode-value keysym) :scancode-escape)
             (sdl2:push-event :quit)))
          (:idle
           () ;; TODO: Not sure why I need this
           (when (> (- (get-internal-run-time)
                       *last-update*)
                    (* internal-time-units-per-second
                       *update-per-sec*))
             (update)
             (draw renderer)
             (setf *last-update* (get-internal-run-time))
             (sdl2:delay 1)
             ))
          (:quit () t))))))